perm filename SOGM[LSP,JRA] blob
sn#122573 filedate 1974-10-02 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00006 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 (DE SOGM (EXP ENV)
C00005 00003 ~SELECTORS
C00006 00004 ~THE PREDICATES
C00008 00005 ~THE CONSTRUCTORS
C00009 00006 ~PRIMITIVE APPLICATIONS--DELTA RULES
C00010 ENDMK
C⊗;
(DE SOGM (EXP ENV)
(COND
((IS_CONST EXP) (DENOTE EXP))
((IS_VAR EXP) (VALUE EXP ENV))
((IS_COND EXP) (EVCOND EXP ENV))
((IS_FUN_ARGS EXP)(APPLY_S (FUN EXP) (LIST_OF_EVALED_ARGS (ARGS EXP) ENV) ENV))))
(DE APPLY_S(FN ARGS ENV)
(COND
((IS_CAR FN) (APPLY_CAR ARGS))
((IS_CDR FN) (APPLY_CDR ARGS))
((IS_CONS FN) (APPLY_CONS ARGS))
((IS_ATOM FN) (APPLY_ATOM ARGS))
((IS_EQ FN) (APPLY_EQ ARGS))
((IS_NAME FN) (APPLY_S (SOGM FN ENV) ARGS ENV))
((IS_λ FN) (SOGM (BODY FN) (NEW_ENV (VARS FN) ARGS ENV)))
))
(DE DENOTE (EXP)
(COND
((IS_NUMBER EXP) EXP)
((IS_TRUTH EXP) EXP)
((IS_FALSE EXP) EXP)
((IS_SEXPR EXP) EXP)
))
(DE VALUE(VAR ENV)
(COND
((NULL ENV) UNDEFINED_VAR)
((EQ VAR (NAME(FIRST ENV))) (VAL(FIRST ENV)))
(T (VALUE VAR (REST ENV)))
))
(DE EVCOND (EXP ENV)
(COND
((NULL ENV) COND_UNDEFINED)
((SOGM (P(FIRST EXP)) ENV)(SOGM (E (FIRST EXP)) ENV))
(T (EVCOND (REST EXP) ENV))
))
(DE LIST_OF_EVALED_ARGS(ARGS ENV)
(COND
((NULL ARGS) NIL)
(T (CONS (SOGM (FIRST ARGS) ENV)
(LIST_OF_EVALED_ARGS (REST ARGS) ENV)))
))
(DE NEW_ENV (VARS VALS ENV)
(COND
((NULL VARS) ENV)
(T (CONS (MAKE_ENTRY (FIRST VARS)(FIRST VALS))
(NEW_ENV (REST VARS)(REST VALS) ENV)))
))
~SELECTORS
(DE FIRST (X)(CAR X))
(DE REST (X)(CDR X))
(DE FUN(X)(CAR X))
(DE ARGS(X)(CDR X))
(DE BODY(X)(CADDR X))
(DE VARS(X)(CADR X))
(DE NAME(X)(CAR X))
(DE VAL(X)(CDR X))
(DE P(X)(CAR X))
(DE E(X)(CADR X))
~THE PREDICATES
(DE IS_CONST(EXP)
(COND
((IS_NUMBER EXP) T)
((IS_TRUTH EXP) T)
((IS_FALSE EXP) T)
((IS_SEXPR EXP) T)
(T FALSE)
))
(DE IS_VAR(X)(ATOM X))
(DE IS_COND(X)(EQ(CAR X) (QUOTE COND)))
(DE IS_FUN_ARGS (X) T)
(DE IS_CAR (X)(EQ X(QUOTE CAR)))
(DE IS_CDR (X)(EQ X(QUOTE CDR)))
(DE IS_CONS (X)(EQ X(QUOTE CONS)))
(DE IS_EQ (X)(EQ X(QUOTE EQ)))
(DE IS_ATOM (X)(EQ X(QUOTE ATOM)))
(DE IS_NAME (X)(ATOM X))
(DE IS_λ(X)(EQ (CAR X)(QUOTE LAMBDA)))
(DE IS_NUMBER(X)(NUMBERP X))
(DE IS_TRUTH(X)(EQ X T))
(DE IS_FALSE(X)(EQ X FALSE))
(DE IS_SEXPR(X)(EQ(CAR X) (QUOTE QUOTE)))
(SETQ FALSE NIL)
~THE CONSTRUCTORS
(DE MAKE_ENTRY(X Y)(CONS X Y))
~PRIMITIVE APPLICATIONS--DELTA RULES
(DE APPLY_CAR(X)(CAAR X))
(DE APPLY_CDR(X)(CDAR X))
(DE APPLY_CONS(X)(CONS (CAR X)(CADR X)))
(DE APPLY_EQ(X)(EQ(CAR X)(CADR X)))
(DE APPLY_ATOM(X)(ATOM (CAR X)))